{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modParsingClassIMessage;

interface

uses modParsingClassBase,
     modBaseType,
     Classes,
     sFonctionsChaines,
     SysUtils,
     Windows,

     modMessagesList,

     LibXmlParser;


const
    CNT_MESSAGE_IN_TYPEEFFACEMENT = '<<typeeffacement>>';
    CNT_MESSAGE_VAL_TYPEEFFACEMENT_SELECTED    = 'deletemarked';
    CNT_MESSAGE_VAL_TYPEEFFACEMENT_NONSELECTED = 'deletenonmarked';
    CNT_MESSAGE_VAL_TYPEEFFACEMENT_MSGMONTRES  = 'deleteallshown';
    CNT_MESSAGE_VAL_TYPEEFFACEMENT_TOUS        = 'deleteall';

    
type
    TParsingMessagesList = class(IParsingRedirection)
    private

        FPageToPost: string;

        FNbFormTag : integer;

        // Contient simplement: deletemessages=deleteallshown&messages=1
        // si on efface les messages montrés
        FDataToPost: string;


        FMessageList: TCollectionOGMessage;

        FInTable: integer;
        FCurrTableLigne  : integer;
        FCurrTableColonne: integer;

        FCurrMsg: TOGMessage;
        FThisLigneIsContent: integer;


        FIsInRapportCombat: boolean;


        FCurrBuffer: string;

        procedure InitMsg;
        function IsValidMsg: boolean;


    public
        property DataToPost : string read FDataToPost;
        property PageToPost : string read FPageToPost;

        property MessageList: TCollectionOGMessage read FMessageList;



       /////////////////////////////////////////////////////////////////////////
       // Implémentation de IParsingRedirection

        // initialise l'interface
        procedure Initialisation; override;

        // obtient le résultat d'analyse
        function  GetFinalState: TParsingResultState; override;

        procedure SetFullURLFromBase(const BaseLink: string); override;


        procedure ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); override;
        procedure ScanOnEndTag(Sender: TObject; TagName: string); override;
        procedure ScanOnContent(Sender: TObject; Content: string); override;

       //
       /////////////////////////////////////////////////////////////////////////

        
        constructor Create;
        destructor Destroy; override;
    end;


implementation

uses modLanguageParsing,
     sHTMLFonctions,

     ESBDates,
     modCore;


////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Liste des messages pour récupérer les rapports d'espionnage

procedure TParsingMessagesList.Initialisation;
begin
    inherited;

    FDataToPost := '';
    FPageToPost := '';

    FInTable := -1;

    FThisLigneIsContent := -1;

    InitMsg;
    FNbFormTag := 0;

    FMessageList.Clear;

    FError := false;



end;

function TParsingMessagesList.GetFinalState: TParsingResultState;
begin
    Result := PRESULT_ECHEC;


    if FError then begin
       exit;
    end;

    Result := NoT(PRESULT_ECHEC);


end;



(*
<tr>
       <td class="b"> </td><td colspan="3" class="b"><table width=400><tr><td class=c colspan=4>Matières premières sur XXXXXXXX [0:0:0] pour 07-07 07:07:07</td></tr>
<tr><td>Métal:</td><td>83135</td>
<td>Cristal:</td><td>30538</td></tr>

<tr><td>Deutérium:</td><td>12859</td>
<td>Énergie:</td><td>4536</td></tr>
</table>
<table width=400><tr><td class=c colspan=4>Flottes     </td></tr>
</table>
<center> Probabilité de défense contre-espionnage:0%</center>
</td>
    </tr>

doit être converti en:

Matières premières sur XXXXX [0:0:0] pour 10-14 21:50:32
Métal:	83135 	Cristal:	30538
Deutérium:	12859 	Énergie:	4536
Flottes
Probabilité de défense contre-espionnage:0%
*)


procedure TParsingMessagesList.SetFullURLFromBase(const BaseLink: string);
begin
    FPageToPost  := sHTML_Get_URL_Lien(BaseLink, FPageToPost);

    FMessageList.SetURLOfPage(BaseLink);

    inherited;
end;


constructor TParsingMessagesList.Create;
begin
    inherited;

    FMessageList := TCollectionOGMessage.Create;
end;

destructor TParsingMessagesList.Destroy;
begin

    FMessageList.Free;

    inherited;
end;

procedure TParsingMessagesList.InitMsg;
begin
    FCurrMsg.CheckBox := '';
    FCurrMsg.Date     := '';
    FCurrMsg.Emetteur := '';
    FCurrMsg.Sujet    := '';
    FCurrMsg.Contenu  := '';
    FCurrMsg.RapportCombatLink := '';

    FCurrMsg.DateInt.Mois    := 0;
    FCurrMsg.DateInt.Jour    := 0;
    FCurrMsg.DateInt.Heure   := 0;
    FCurrMsg.DateInt.Minute  := 0;
    FCurrMsg.DateInt.Seconde := 0;
end;

function TParsingMessagesList.IsValidMsg: boolean;
label lUsageCurrYear;
var xMonth: word;
    MsgDate: TDateTime;
begin

    Result := true;

    if (FCurrMsg.CheckBox = '') or (FCurrMsg.Date = '') or (FCurrMsg.Emetteur = '') or (FCurrMsg.Contenu = '') then
       Result := false;

    if Result = false then begin
       if FCurrMsg.RapportCombatLink <> '' then begin
          // le contenu est vide pour un rapport de combat
          if (FCurrMsg.CheckBox = '') or (FCurrMsg.Date = '') or (FCurrMsg.Emetteur = '') then begin
             Result := false;
          end else begin
             Result := true;
          end;
       end;
    end;

    if Result then begin
       Result := mmlIsValidDate(FCurrMsg.DateInt);

       if Result then begin
          // ok, message valide
          // on estime la date
          MsgDate := EncodeTime(FCurrMsg.DateInt.Heure, FCurrMsg.DateInt.Minute, FCurrMsg.DateInt.Seconde, 0);


          xMonth := ThisMonth;


          if xMonth = FCurrMsg.DateInt.Mois then begin
             // même mois
             // on utilise l'année actuelle
lUsageCurrYear:
             MsgDate := MsgDate + EncodeDate(ThisYear, FCurrMsg.DateInt.Mois, FCurrMsg.DateInt.Jour);
             FCurrMsg.DateEstimation := DateTimeToUnix(MsgDate);

          end else  begin
             // le mois est plus petit que le mois actuel
             // ce n'est pas forcément un changement d'année
             // SAUF, si les mois concernés sont décembre et janvier
             // on part du principe que les messages peuvent dater que plusieurs jours
             // (15 au maximum on va dire)
             // La fonction de date a de toute façon pour but un usage immédiat lors de
             // l'extraction d'un rapport d'espionnage pour le sondage avant impact
             // ou le sondage avant d'attaquer (pour la liste d'attente de raid)

             if (xMonth > 1) and (xMonth < 12) then begin
                // ok, on utilise l'année actuelle
                goto lUsageCurrYear;

             end else begin
                // le mois actuel est soit janvier, soit décembre

                if (xMonth = 12) and (FCurrMsg.DateInt.Mois > 6) then begin
                   // cas où FCurrMsg.DateInt.Mois = 11
                   // l'heure du pc avance par rapport au jeu, et on est à la fin du mois de novembre
                   // on utilise l'année actuelle
                   goto lUsageCurrYear;

                end else if (xMonth = 1) and (FCurrMsg.DateInt.Mois < 6) then begin
                   // cas où FCurrMsg.DateInt.Mois = 2
                   // l'heure du pc retarde par rapport au jeu, et on est à la fin du mois de janvier
                   // on utilise l'année actuelle
                   goto lUsageCurrYear;

                   
                end else begin
                   // sinon, il y a un changement d'année possible...
                   
                   if (xMonth = 12) then begin
                      // dans ce cas, FCurrMsg.DateInt.Mois <= 6 car le > 6 a déjà été traité
                      MsgDate := MsgDate + EncodeDate(ThisYear + 1, FCurrMsg.DateInt.Mois, FCurrMsg.DateInt.Jour);
                      FCurrMsg.DateEstimation := DateTimeToUnix(MsgDate);
                   end else begin
                      // xMonth = 1 et FCurrMsg.DateInt.Mois >= 6 car < 6 déjà traité
                      MsgDate := MsgDate + EncodeDate(ThisYear - 1, FCurrMsg.DateInt.Mois, FCurrMsg.DateInt.Jour);
                      FCurrMsg.DateEstimation := DateTimeToUnix(MsgDate);
                   end;
                end;

             end;
             
          end;



       end;
    end;
end;


procedure TParsingMessagesList.ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList);
var CurrBalise: string;
    lng, xPos : integer;
begin

    TagName := lowercase(TagName);

    if TagName = 'table' then begin
        if FInTable < 0 then exit;

        Inc(FInTable);

    end else if TagName = 'form' then begin

       // <form action="messages.php?session=00000000" method="POST">
       CurrBalise := Attributes.Value('action');

       FPageToPost := CurrBalise;

       // Indique que l'on est dans le tableau
       FInTable := 1;
       FCurrTableLigne := 0;
       FCurrTableColonne := 0;

       Inc(FNbFormTag);
       exit;
    end;

    if FInTable < 0 then exit;


    if TagName = 'tr' then begin
        if FInTable = 1 then begin
           Inc(FCurrTableLigne);
           FCurrTableColonne := 0;

        end else if FInTable > 1 then begin
           // On est alors dans un rapport d'espionnage
           // Rajoute un saut de ligne
           if FThisLigneIsContent = FCurrTableLigne then begin
              lng := length(FCurrBuffer);
              if lng > 0 then begin
                 // Vérifie si le retour à la ligne n'existe pas déjà
                 if FCurrBuffer[lng] <> #$0A then
                    FCurrBuffer := FCurrBuffer + #$0D#$0A;

              end;
           end;

        end;

        
    end else if (TagName = 'td') or (TagName = 'th') then begin
        if FInTable = 1 then begin
           Inc(FCurrTableColonne);
        end;

    end else if TagName = 'a' then begin
        // pour la sauvegarde de rapport de combat
(*<tr><th><input type="checkbox" name="delmes01111" /></th>
     <th>11-11 00:00:00</th>
     <th>Fleet Command </th>
     <th><a href="#" onclick="fenster('bericht.php?xtid&bericht=1111111', 'Bericht');" ><span class="combatreport">Battle Report (0,7) [1:11:1] (V:0,A:0)</span></a></th>
</tr>*)

        if FCurrTableColonne <> 4 then begin
           // le lien est dans le sujet, c'est à dire dans la colonne 4
           exit;
        end;

        CurrBalise := Attributes.Value('onclick');

        // on n'obtient pas directement le lien, mais plutôt:
        // fenster('bericht.php?xtid&bericht=044444', 'Bericht');
        if CurrBalise <> '' then begin
           xPos := pos('''', CurrBalise);

           if xPos > 0 then begin
              System.Delete(CurrBalise, 1, xPos);

              xPos := pos('''', CurrBalise);
              if xPos > 0 then begin
                 System.Delete(CurrBalise, xPos, maxint);

                 CurrBalise := trim(CurrBalise);
                 
                 if length(CurrBalise) > 12 then begin
                    // CurrBalise contient maintenant le lien à télécharger
                    FCurrMsg.RapportCombatLink := CurrBalise;
                    FIsInRapportCombat := true;
                 end;

              end;
           end;
        end;




    end else if TagName = 'input' then begin
        // <input type="checkbox" name="delmes011111111" />
        // <input type="hidden" name="messages" value="1" />
        // <input type="checkbox" name="fullreports"  />

        CurrBalise := lowercase(trim(Attributes.Value('type')));

        if CurrBalise = 'checkbox' then begin
            // comment traiter les checkbox ?
            // car si il y en a une qui n'est pas coché, elle ne figure pas
            // dans les données à poster


            // La ligne suivante sera un contenu, on peut également identifié
            // le contenu avec la balise <td colspan="3" class="b">
            // qui figure avant chaque contenu


            lng := length(FCurrBuffer);
            if lng > 0 then begin
               if FCurrBuffer[lng] = #$0A then begin
                  System.Delete(FCurrBuffer, lng - 1, 2);
               end;

            end;

            FCurrMsg.Contenu := FCurrBuffer;

            if IsValidMsg then begin
               // ajoute le message le précédent
               // puis on initialise le nouveau message
               FMessageList.Add(FCurrMsg);

            end;

            FThisLigneIsContent := FCurrTableLigne + 1;
            FCurrBuffer := '';
            InitMsg;

            FCurrMsg.CheckBox := trim(Attributes.Value('name'));

        end else if CurrBalise = 'hidden' then begin
            if FDataToPost = '' then
               FDataToPost :=  trim(Attributes.Value('name')) + '=' + trim(Attributes.Value('value'))
            else
               FDataToPost := FDataToPost + '&' + trim(Attributes.Value('name')) + '=' + trim(Attributes.Value('value'));

        end else if CurrBalise = 'submit' then begin
            // <input type="submit" value="ok" />
               
        end else begin
            // Non prévu
            // Erreur
            FError := true;
        end;


    end else if TagName = 'center' then begin

              lng := length(FCurrBuffer);
              if lng > 0 then begin
                 // Vérifie si le retour à la ligne n'existe pas déjà
                 if FCurrBuffer[lng] <> #$0A then
                    FCurrBuffer := FCurrBuffer + #$0D#$0A;

              end;

    end else if TagName = 'select' then begin


(*   <select name="deletemessages">
       <option value="deletemarked">Effacer les messages sélectionnés</option>
       <option value="deletenonmarked">Effacer tous les messages qui ne sont pas choisis</option>
       <option value="deleteallshown">Effacer tous les messages montrés </option>
       <option value="deleteall">Effacer tous les messages</option>
      </select>
      *)

        CurrBalise := lowercase(trim(Attributes.Value('name')));

        if SameText(CurrBalise, 'deletemessages') then begin
            if FDataToPost = '' then
               FDataToPost :=  trim(Attributes.Value('name')) + '=' + CNT_MESSAGE_IN_TYPEEFFACEMENT
            else
               FDataToPost := FDataToPost + '&' + trim(Attributes.Value('name')) + '=' + CNT_MESSAGE_IN_TYPEEFFACEMENT;

               
            if IsValidMsg then begin
               // ajoute le message

            end;
            FCurrBuffer := '';
            InitMsg;


        end else begin
           // Select inconnu
           FError := true;

        end;

    end else if TagName = 'option' then begin
        CurrBalise := lowercase(trim(Attributes.Value('value')));

        if SameText(CurrBalise, 'deletemarked') then begin

        end else if SameText(CurrBalise, 'deletenonmarked') then begin
        end else if SameText(CurrBalise, 'deleteallshown') then begin
        end else if SameText(CurrBalise, 'deleteall') then begin

        end else begin
           // Option inconnue
           FError := true;

        end;

    end;

end;

procedure TParsingMessagesList.ScanOnEndTag(Sender: TObject; TagName: string);
var CurrBalise: string;
    lng: integer;
begin

    if FInTable < 0 then exit;
    TagName := lowercase(TagName);

    if TagName = 'table' then begin
       Dec(FInTable);

    end else if TagName = 'tr' then begin

        if FInTable > 1 then begin
           // On est alors dans un rapport d'espionnage
           // Rajoute un saut de ligne (on le place normalement dans l'ouverture
           // de ligne, mais ils ne respectent pas les stardards (volontairement probablement)
           if FThisLigneIsContent = FCurrTableLigne then begin
              lng := length(FCurrBuffer);

              if lng > 0 then begin
                 if FCurrBuffer[lng] <> #$0A then
                    FCurrBuffer := FCurrBuffer + #$0D#$0A;

              end;
           end;

        end;

    end;
    
end;

procedure TParsingMessagesList.ScanOnContent(Sender: TObject; Content: string);
var lng: integer;
begin
    if FInTable < 0 then exit;
    if FCurrTableColonne < 1 then exit;
    if FCurrTableLigne < 2 then exit;


    if FIsInRapportCombat then begin
       // on est dans un rapport de combat
       FIsInRapportCombat := false;

       if FCurrTableColonne = 4 then begin
          // le lien est dans le sujet, c'est à dire dans la colonne 3
          // Battle Report (0,7) [1:0:1] (V:0,A:0)

          // Le rapport de combat n'ayant pas de contenu, on lui en défini un:
          //FCurrMsg.Contenu := Content;


       end;

    end;

    if FThisLigneIsContent = FCurrTableLigne then begin
       lng := length(FCurrBuffer);

       if lng > 0 then begin

          if FCurrBuffer[lng] = #$0A then
             FCurrBuffer := FCurrBuffer + Content
          else
             FCurrBuffer := FCurrBuffer + ' ' + Content;

       end else
          FCurrBuffer := Content;

    end else begin

        case FCurrTableColonne of
             2: begin
                    // Les dates semblent être au même format tout le temps
                    // mais il manque l'année...
                    //  fr: 10-19 15:29:22
                    // org: 10-20 01:21:24
                    FCurrMsg.Date    := Content;
                    FCurrMsg.DateInt := mmlParsingDate(Content);

                    // l'estimation s'effectue dans la vérification de validité du message
                    FCurrMsg.DateEstimation := 0;

                end;
             3: begin
                    FCurrMsg.Emetteur := Content;
                end;
             4: begin
                    // Le sujet est en deux partie dans la nouvelle version car
                    // les coordonnées sont sous forme de lien (balise A)
                    if FCurrMsg.Sujet = '' then begin
                       FCurrMsg.Sujet := Content;
                    end else begin
                       FCurrMsg.Sujet := FCurrMsg.Sujet + ' ' + Content;
                    end;

                end;

        end;

    end;
    


end;






end.
